home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / library / reqtlsdv.lha / ReqTools / Glue / M2Sprint / m2sprint_glue.lha / Demo.mod < prev    next >
Text File  |  1992-02-13  |  8KB  |  227 lines
  1. MODULE Demo;
  2. (**********************************
  3.  *                                *
  4.  *  reqtools.library (V37)        *
  5.  *                                *
  6.  *  Release 1.0                   *
  7.  *                                *
  8.  *  (c) 1991 Nico François        *
  9.  *                                *
  10.  *  Modula-2 Version 1.0          *
  11.  *  (c) 1992 Michael Griebling    *
  12.  *                                *
  13.  *  Demo.mod                      *
  14.  *                                *
  15.  *  This source is public domain  *
  16.  *  in all respects.              *
  17.  *                                *
  18.  *********************************)
  19.  
  20. FROM SYSTEM      IMPORT ADR, ADDRESS;
  21. FROM DOSProcess  IMPORT Delay;
  22. FROM Hooks       IMPORT Hook;
  23. FROM InOut       IMPORT WriteString, WriteLn;
  24. FROM Intuition   IMPORT IDCMPFlagSet, IDCMPFlags;
  25. FROM ReqTools    IMPORT rtFileRequesterPtr, rtFontRequesterPtr, OpenReqToolsLib,
  26.                         vEZRequest, EZRequest, GetString, GetLong, AllocRequest,
  27.                         FileRequest, FreeRequest, PaletteRequest, EZRequestA,
  28.                         RTFILEREQ, RTFONTREQ, RTFIFlags, FReqFlagSet, RTReqPos,
  29.                         FReqFlags, FileRequestA, RTEZDefaultResponse,
  30.                         RTIDCMPFlags, REQPOSTOPLEFTSCR, REQPOSCENTERSCR,
  31.                         EZRequestTags, FontRequest;
  32. FROM TagItem     IMPORT Tag, TagIs1;
  33. FROM VarCallArgs IMPORT ArgIs, ArgIs2;
  34.  
  35. VAR
  36.   filereq  : rtFileRequesterPtr;
  37.   fontreq  : rtFontRequesterPtr;
  38.   myhook   : Hook;
  39.   filename : ARRAY [0..34] OF CHAR;
  40.   directory: ARRAY [0..34] OF CHAR;
  41.   buffer   : ARRAY [0..128] OF CHAR;
  42.   ret      : LONGINT;
  43.   longnum  : LONGINT;
  44.   color    : LONGINT;
  45.  
  46.  
  47. PROCEDURE myputs (str : ARRAY OF CHAR);
  48. BEGIN
  49.   WriteString(str); WriteLn;
  50. END myputs;
  51.  
  52.  
  53. BEGIN
  54.   IF NOT OpenReqToolsLib() THEN
  55.     myputs ("You need reqtools.library V37 or higher!");
  56.     myputs ("Please install it in your Libs: drirectory.");
  57.   ELSE
  58.     myputs ("");
  59.     myputs ("ReqTools Demo");
  60.     myputs ("¯¯¯¯¯¯¯¯¯¯¯¯¯");
  61.     myputs ("This program demonstrates what 'reqtools.library' ");
  62.     myputs ("has to offer.");
  63.     Delay (60);
  64.  
  65.     vEZRequest("`reqtools.library' offers several\ndifferent types of requesters:",
  66.                "Let's see them", NIL, NIL);
  67.  
  68.     vEZRequest ("NUMBER 1:\nThe larch :-)", "Be serious!", NIL, NIL);
  69.  
  70.     vEZRequest ("NUMBER 1:\nString requester\nfunction: GetString()",
  71.                 "Show me", NIL, NIL);
  72.  
  73.     buffer := "A bit of text";
  74.     IF NOT GetString (buffer, 127, "Enter anything:", NIL) THEN
  75.       vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  76.     ELSE
  77.       vEZRequest ("You entered this string:\n'%s'.", "So I did", NIL,
  78.                   ArgIs(ADR(buffer)));
  79.     END;
  80.  
  81.     vEZRequest ("NUMBER 2:\nNumber requester\nfunction: GetLong()",
  82.                 "Show me", NIL, NIL);
  83.  
  84.  
  85.     IF NOT GetLong (longnum, "Enter a number:", NIL) THEN
  86.       vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  87.     ELSE
  88.       vEZRequest ("The number you entered was:\n%ld",
  89.                   "So it was", NIL, ArgIs(longnum));
  90.     END;
  91.  
  92.     vEZRequest ("NUMBER 3:\nNotification requester, the requester\nyou've been using all the time!\nfunction:EZRequest()",
  93.                 "Show me more", NIL, NIL);
  94.  
  95.     vEZRequest ("Simplest usage: some body text and\na single centered gadget.",
  96.                 "Got it", NIL, NIL);
  97.  
  98.     WHILE EZRequest (
  99.             "You can also use two gadgets to\nask the user something.\nDo you understand?",
  100.             "Of course|Not really", NIL, NIL) = 0 DO
  101.       vEZRequest ("You are not one of the brightest are you?\nWe'll try again...",
  102.               "Ok", NIL, NIL);
  103.     END;
  104.  
  105.     vEZRequest ("Great, we'll continue then.", "Fine", NIL, NIL);
  106.  
  107.     CASE INTEGER(EZRequest (
  108.            "You can also put up a requester with\nthree choices.\nHow do you like the demo so far?",
  109.        "Great|So so|Rubbish", NIL, NIL)) OF
  110.       0 : vEZRequest ("Too bad, I really hoped you\nwould like it better.",
  111.                   "So what", NIL, NIL)
  112.         |
  113.       1 : vEZRequest ("I'm glad you like it so much.", "Fine", NIL, NIL)
  114.             |
  115.       2 : vEZRequest ("Maybe if you run the demo again\nyou'll REALLY like it.",
  116.                   "Perhaps", NIL, NIL)
  117.         |
  118.     END;
  119.     ret := EZRequestTags (
  120.       "The number of responses is not limited to three\nas you can see.  The gadgets are labeled with\nthe return code from EZRequest().\nPressing Return will choose 4, note that\n4's button text is printed in boldface.",
  121.       "1|2|3|4|5|0", NIL, NIL, TagIs1(RTEZDefaultResponse, 4));
  122.     vEZRequest ("You picked '%ld'.", "How true", NIL, ArgIs(ret));
  123.  
  124.     vEZRequest (
  125.       "You may also use C-style formatting codes in the body text.\nLike this:\n\n'The number %%ld is written %%s.' will give:\n\nThe number %ld is written %s.\n\nif you also pass '5' and '\"five\"' to EZRequest().",
  126.       "Proceed", NIL, ArgIs2(5, ADR("five")));
  127.  
  128.     IF EZRequestTags (
  129.       "It is also possible to pass extra IDCMP flags\nthat will satisfy EZRequest(). This requester\nhas had DISKINSERTED passed to it.\n(Try inserting a disk).",
  130.       "Continue", NIL, NIL, TagIs1(RTIDCMPFlags, LONGCARD(IDCMPFlagSet{DiskInserted})))
  131.       = LONGINT(IDCMPFlagSet{DiskInserted}) THEN
  132.       vEZRequest ("You inserted a disk.", "I did", NIL, NIL);
  133.     ELSE
  134.       vEZRequest ("You used the 'Continue' gadget\nto satisfy the requester.",
  135.                   "I did", NIL, NIL);
  136.     END;
  137.  
  138.     ret := EZRequestTags (
  139.              "Finally, it is possible to specify the position\nof the requester.\nE.g. at the top left of the screen, like this.\nThis works for all requesters, not just EZRequest()!",
  140.              "Amazing", NIL, NIL, TagIs1(RTReqPos, REQPOSTOPLEFTSCR));
  141.  
  142.     ret := EZRequestTags (
  143.              "Alternatively, you can center the\nrequester on the screen.\nCheck out 'reqtools.doc' for all the possibilities.",
  144.              "I'll do that", NIL, NIL, TagIs1(RTReqPos, REQPOSCENTERSCR));
  145.  
  146.     vEZRequest ("NUMBER 4:\nFile requester\nfunction: FileRequest()",
  147.                 "Demonstrate", NIL, NIL);
  148.  
  149.     filereq := AllocRequest (RTFILEREQ);
  150.     IF filereq # NIL THEN
  151.       filename := "";
  152.       directory := "";
  153.       IF FileRequest (filereq, filename, directory, "Pick a file") THEN
  154.     vEZRequest (
  155.       "You picked the file:\n'%s'\nin directory:\n'%s'",
  156.       "Right", NIL, ArgIs2(ADR(filename), LONGCARD(filereq^.Dir)));
  157.       ELSE
  158.     vEZRequest ("You didn't pick a file.", "No", NIL, NIL);
  159.       END;
  160.       FreeRequest (filereq);
  161.     ELSE
  162.       vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  163.     END;
  164.  
  165.  
  166.     vEZRequest (
  167.       "The file requester can be used\nas a directory requester as well.",
  168.       "Let's see that", NIL, NIL);
  169.  
  170.     filereq := AllocRequest (RTFILEREQ);
  171.     IF filereq # NIL THEN
  172.       IF FileRequestA (filereq, filename, ADR("Pick a directory"),
  173.                TagIs1(RTFIFlags, LONGCARD(FReqFlagSet{NoFiles}))) THEN
  174.     vEZRequest ("You picked the directory:\n'%s'", "Right", NIL,
  175.                 ArgIs(LONGCARD(filereq^.Dir)));
  176.       ELSE
  177.     vEZRequest ("You didn't pick a directory.", "No", NIL, NIL);
  178.       END;
  179.       FreeRequest (filereq);
  180.     ELSE
  181.       vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  182.     END;
  183.  
  184.     vEZRequest ("NUMBER 5:\nFont requester\nfunction: FontRequest()",
  185.             "Show", NIL, NIL);
  186.  
  187.  
  188.     fontreq := AllocRequest (RTFONTREQ);
  189.     IF fontreq # NIL THEN
  190.       fontreq^.Flags := FReqFlagSet{Style, ColorFonts};
  191.  
  192. (*
  193.     (* sorry - I haven't implemented the hooks for M2 *)
  194.         myhook.h_Entry = hookfunc;
  195.         fontreq->Hook = &myhook;
  196.         fontreq->Flags |= FREQF_DOWILDFUNC;
  197. *)
  198.  
  199.       IF FontRequest (fontreq, "Pick a font") THEN
  200.     vEZRequest ("You picked the font:\n'%s'\nwith size:\n'%ld'", "Right", NIL,
  201.             ArgIs2(LONGCARD(fontreq^.Attr.taName), fontreq^.Attr.taYSize));
  202.       ELSE
  203.     vEZRequest ("You canceled.\nWas there no font you liked ?",
  204.             "Nope", NIL, NIL);
  205.       END;
  206.  
  207.       FreeRequest (fontreq);
  208.     ELSE
  209.       vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  210.     END;
  211.  
  212.  
  213.     vEZRequest ("NUMBER 6:\nPalette requester\nfunction: PaletteRequest()",
  214.       "Proceed", NIL, NIL);
  215.  
  216.     color := PaletteRequest ("Change palette", NIL);
  217.     IF (color = -1) THEN
  218.       vEZRequest ("You canceled.\nNo nice colors to be picked ?", "Nah", NIL, NIL);
  219.     ELSE
  220.       vEZRequest ("You picked color number %ld.", "Sure did", NIL, ArgIs(color));
  221.     END;
  222.  
  223.     (* free all resources *)
  224.     myputs ("\nFinished, hope you enjoyed the demo :-)\n");
  225.   END;
  226.  
  227. END Demo.